Option Explicit

'
'  Add MSOffice document Version, Revision, Last Modifier and Last Save date to filename.

'  Author:     $Author: PauThompson.CACI.com@gmail.com $
'  Creator:    $Creator$
'  Originator: $Originator:$
'  Date:       $Date: 2014-12-19 11:58:15 +0000 (Fri, 19 Dec 2014) $
'  DateTime:   $DateTime$
'  File:       $File$
'  Script:     $Script$
'  Requires:   $Requires$
'  Provides:   $Provides$
'  Change:     $Change$
'  Revision:   $Revision: 11 $
'  URL:        $URL: http://legato-vibrato.googlecode.com/svn/office_doc_file_smart_rename/trunk/doc_props.vbs $
'  Id:         $Id: doc_props.vbs 11 2014-12-19 11:58:15Z PauThompson.CACI.com@gmail.com $
'  Header:     $Header: http://legato-vibrato.googlecode.com/svn/office_doc_file_smart_rename/trunk/doc_props.vbs 11 2014-12-19 11:58:15Z PauThompson.CACI.com@gmail.com $

Dim strLastAuthor , strDocVersion , strDocRev , dtLastSaveTime

' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Design Docs\HCPSS Phase II.vsdx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Serena\SBM\10.1.4.1\wc_guide.pdf")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\SmartCard authentication\SmartCard Setup.mht")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\Actors-Roles listed in Rqmts.txt")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Education\CVU_Catalog.xls")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\TimeClock exports\Timeclock_export.20140912-20141017.csv")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Sprint Meeting Agendas\(Mayra) HCPSS Release 2 0 Sprint 1 Status Ver 1 2.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\ENBOSS-TRN\ENBOSSARIMD-PRN-Training for Task Workflow.ppt")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\CACI-TRN\CACI-PRN-SBM Development.pptx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Schedule\HCPSS2_Schedule_Draft v1.5.mpp")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\ENBOSS Training\ENBOSS-PFLO-Peer_Review.vsd")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\OnBoarding\Orientation\CACI Apps Portal.doc")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\140929 HCPSS Phase 2 requirements v3.4.docx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\hcpss2_requirements_matrix.201412021915.r10.pt.xlsx")

' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F1.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F2.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F3.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F4.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F5.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F6.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F7.xlsx")
' Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F8.xlsx")
Call DumpFileSysInfo("C:\Users\pauthompson\Documents\Source\VBScript\F9.xlsx")

'  Microsoft VBScript runtime error: ActiveX component can't create object: 'Office.Application'
'     dim objOfficeApp
'     Set objOfficeApp = CreateObject("Office.Application")

' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F1.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F2.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F3.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F4.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F5.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F6.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F7.xlsx")
' Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F8.xlsx")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Source\VBScript\F9.xlsx")

WScript.Quit 0


Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Design Docs\HCPSS Phase II.vsdx")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Serena\SBM\10.1.4.1\wc_guide.pdf")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\SmartCard authentication\SmartCard Setup.mht")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\Actors-Roles listed in Rqmts.txt")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Education\CVU_Catalog.xls")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\TimeClock exports\Timeclock_export.20140912-20141017.csv")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Sprint Meeting Agendas\(Mayra) HCPSS Release 2 0 Sprint 1 Status Ver 1 2.xlsx")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\ENBOSS-TRN\ENBOSSARIMD-PRN-Training for Task Workflow.ppt")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\CACI-TRN\CACI-PRN-SBM Development.pptx")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Schedule\HCPSS2_Schedule_Draft v1.5.mpp")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\PEO EIS\DWTS\ENBOSS Training\ENBOSS-PFLO-Peer_Review.vsd")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\OnBoarding\Orientation\CACI Apps Portal.doc")
Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\140929 HCPSS Phase 2 requirements v3.4.docx")

Call DumpOfficeDocInfo("C:\Users\pauthompson\Documents\Clients\Dept of Ed\HCPSS Phase II\Requirements Docs\hcpss2_requirements_matrix.201412021915.r10.pt.xlsx")

'  Call GetExcelProps(strFname,strLastAuthor,strDocVersion,strDocRev,dtLastSaveTime)
'
'  wscript.echo "Last author=" & strLastAuthor
'  wscript.echo "Document version=" & strDocVersion
'  wscript.echo "Revision number=" & strDocRev
'  wscript.echo "Last save time=" & dtLastSaveTime & " == " &  IsoTime(dtLastSaveTime)


WScript.Quit 0

' *****************************************************************************
' *****************************************************************************

Sub DumpFileSysInfo(str_Fname)
   Dim fso, obj_Drive , obj_Fldr , obj_SpecialFldr
   Const ForReading = 1
WScript.Echo "DumpFileSysInfo"

   Set fso = CreateObject("Scripting.FileSystemObject")
WScript.Echo vbCrLf & String(80,"-") & vbCrLf & str_Fname & vbCrLf & "type of fso=" & typename(fso)


   If fso.FileExists(str_Fname) Then

      WScript.Echo "   File Exists"
      wscript.echo "   AbsolutePathName=" & fso.GetAbsolutePathName(str_Fname)
         Set obj_Drive = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(str_Fname)))

         wscript.echo   "   Drive=" & fso.GetDriveName(fso.GetAbsolutePathName(str_Fname)) & _
                        " {"  & obj_Drive.FileSystem & ";" & obj_Drive.VolumeName & ";" & Hex(obj_Drive.SerialNumber) & "}"

         '  WScript.Echo "   Drive AvailableSpace=" & obj_Drive.AvailableSpace
         '  WScript.Echo "   Drive DriveLetter=" & obj_Drive.DriveLetter
         '  WScript.Echo "   Drive DriveType=" & obj_Drive.DriveType
         '  WScript.Echo "   Drive FileSystem=" & obj_Drive.FileSystem
         '  WScript.Echo "   Drive FreeSpace=" & obj_Drive.FreeSpace
         '  WScript.Echo "   Drive IsReady=" & obj_Drive.IsReady
         '  WScript.Echo "   Drive Path=" & obj_Drive.Path
         '  WScript.Echo "   Drive RootFolder=" & obj_Drive.RootFolder
         '  WScript.Echo "   Drive SerialNumber = [0x]" & Hex(obj_Drive.SerialNumber)
         '  WScript.Echo "   Drive ShareName=" & obj_Drive.ShareName
         '  WScript.Echo "   Drive TotalSize=" & obj_Drive.TotalSize
         '  WScript.Echo "   Drive VolumeName=" & obj_Drive.VolumeName

      wscript.echo "   FileName=" & fso.GetFileName(str_Fname)
      wscript.echo "   DriveName=" & fso.GetDriveName(str_Fname)


      wscript.echo "   ParentFolderName=" & fso.GetParentFolderName(str_Fname)
      wscript.echo "   BaseName=" & fso.GetBaseName(str_Fname)
      wscript.echo "   ExtensionName=" & fso.GetExtensionName(str_Fname)
      wscript.echo "   FileVersion=" & fso.GetFileVersion(str_Fname)

      On Error Resume Next
      Set obj_Fldr = fso.GetFolder(str_Fname)
      On Error Goto 0
      If Not IsEmpty(obj_Fldr) Then
         WScript.echo "Folder DateCreated=" & obj_Fldr.DateCreated
         WScript.echo "Folder DateLastAccessed=" & obj_Fldr.DateCreated
         WScript.echo "Folder DateLastModified=" & obj_Fldr.DateLastModified
      Else
         wscript.echo "<Can't get Folder>"
      End If

      ' GetSpecialFolder(0|1|2) returns a Folder object for the Windows, System or Temp folder related to the param.
      ' Set obj_SpecialFldr = fso.GetSpecialFolder(TemporaryFolder)

      ' Returns a randomly generated temporary file or folder
      ' wscript.echo "   TempName=" & fso.GetTempName(str_Fname)

   Else
      WScript.Echo "File does NOT exist"
   End If


   Set fso = Nothing


End Sub

' *****************************************************************************

CONST MS_ACCESS_EXTENSIONS = "|accda|accde|accdb|laccdb|accdt|accdu|accdc|accdp|accdr|mda|mde|ade|mdb|mdt|maf|mam|adp|maq|snp|mar|mat|mdw|"
CONST MS_ENTOURAGE_EXTENSIONS = "|vrge08message|"
CONST MS_EXCEL_EXTENSIONS ="|xlsx|xlsb|xlam|xlsm|xltm|xltx|xls|xlt|xla|xll|xar|xlc|xlm|xlam|xltm|xlm|xlsm|xlsb|xl|xla|xll|xlt|xltx|xlw|xlb|xls|xlsx|xlw|"
CONST MS_INFOPATH_EXTENSIONS ="|xsf|xsn|"
CONST MS_INTERNETEXPLORER_EXTENSIONS = "|mht|hta|asp|aspx|"
CONST MS_OFFICE_EXTENSIONS ="|crtx|thmx|acl|pip|ops|thmx|rpmsg|slk|"
CONST MS_ONENOTE_EXTENSIONS ="|one|onepkg|"
CONST MS_OUTLOOK_EXTENSIONS ="|obi|iaf|olm|ost|oab|pst|prf|oft|"
CONST MS_POWERPOINT_EXTENSIONS ="|ppam|ppsm|pptm|sldm|potm|ppsx|pptx|potx|sldx|ppa|pps|ppt|pot|pa|ppam|pptm|ppsm|sldm|potm|ppt|pptx|pps|ppsx|sldx|pot|potx|"
CONST MS_PROJECT_EXTENSIONS ="|mpd|mpp|mpt|"
CONST MS_PUBLISHER_EXTENSIONS ="|pub|puz|"
CONST MS_SHAREPOINT_EXTENSIONS ="|grv|"
CONST MS_VISIO_EXTENSIONS ="|vsd|vsdx|vdx|vst|vss|vsx|vtx|"
CONST MS_WORD_EXTENSIONS = "|docb|dotx|dotm|docx|docm|doc|dot|wll|wbk|asd|doc|docx|svd|docm|dot|dotm|dotx|cnv|"

Sub DumpOfficeDocInfo(str_Fname)
   Dim fso , str_Ext
   Dim vnt_LastAuthor,vnt_DocVersion,vnt_DocRev,vnt_LastSaveTime

WScript.Echo "DumpOfficeDocInfo"

   Set fso = CreateObject("Scripting.FileSystemObject")


   If fso.FileExists(str_Fname) Then
wscript.echo "   AbsolutePathName=" & fso.GetAbsolutePathName(str_Fname)

      str_Ext = LCase(fso.GetExtensionName(str_Fname))
wscript.echo "extension='" & str_Ext & "'"

      If InStr(1,MS_ACCESS_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_ACCESS_EXTENSIONS"

      ElseIf InStr(1,MS_ENTOURAGE_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_ENTOURAGE_EXTENSIONS"
      ElseIf InStr(1,MS_EXCEL_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_EXCEL_EXTENSIONS"
         Call GetExcelProps(str_Fname,vnt_LastAuthor,vnt_DocVersion,vnt_DocRev,vnt_LastSaveTime)
         WScript.Echo   "   vnt_LastAuthor='" & vnt_LastAuthor & "'" & vbCrLf & _
                        "   vnt_DocVersion='" & vnt_DocVersion & "'" & vbCrLf & _
                        "   vnt_DocRev='" & vnt_DocRev & "'" & vbCrLf & _
                        "   vnt_LastSaveTime='" & vnt_LastSaveTime & "'"
      ElseIf InStr(1,MS_INFOPATH_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_INFOPATH_EXTENSIONS"
      ElseIf InStr(1,MS_INTERNETEXPLORER_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_INTERNETEXPLORER_EXTENSIONS"
      ElseIf InStr(1,MS_OFFICE_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_OFFICE_EXTENSIONS"
      ElseIf InStr(1,MS_ONENOTE_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_ONENOTE_EXTENSIONS"
      ElseIf InStr(1,MS_OUTLOOK_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_OUTLOOK_EXTENSIONS"
      ElseIf InStr(1,MS_POWERPOINT_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_POWERPOINT_EXTENSIONS"
      ElseIf InStr(1,MS_PROJECT_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_PROJECT_EXTENSIONS"
      ElseIf InStr(1,MS_PUBLISHER_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_PUBLISHER_EXTENSIONS"
      ElseIf InStr(1,MS_SHAREPOINT_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_SHAREPOINT_EXTENSIONS"
      ElseIf InStr(1,MS_VISIO_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_VISIO_EXTENSIONS"
      ElseIf InStr(1,MS_WORD_EXTENSIONS,str_Ext,vbTextCompare) Then
         WScript.Echo "MS_WORD_EXTENSIONS"
      Else
         WScript.Echo "<Not a known MS Office file extension>"
      End If

   Else
      WScript.Echo "File does NOT exist"
   End If
   Set fso = Nothing

End Sub

' *****************************************************************************

Sub DumpBuiltinProperties(obj_Container)
   Dim obj_Prop , str_PropName , str_PropVal , str_PropValType

   For Each obj_Prop in obj_Container.BuiltInDocumentProperties
      str_PropName = "<property name>"
      str_PropVal = "<property value>"
     str_PropValType = "<unknown>"

      ' If the property doesn't have a name or a value, these lines may error out.
      On Error Resume Next
         str_PropName = obj_Prop.Name
         str_PropValType = TypeName(obj_Prop.Value)
         str_PropVal = obj_Prop.Value
      On Error Goto 0

      Wscript.Echo "Built-in property '" & str_PropName & "' == '" & str_PropVal & "'   {" & str_PropValType & "}"
   Next
End Sub

' *****************************************************************************

Sub GetExcelProps(str_Fname,vnt_LastAuthor,vnt_DocVersion,vnt_DocRev,vnt_LastSaveTime)

   Dim obj_Excel ,obj_Workbook
   Set obj_Excel = CreateObject("Excel.Application")
   obj_Excel.Visible = False
   Set obj_Workbook = obj_Excel.Workbooks.Open(str_Fname)

WScript.Echo "obj_Excel doesn't support built-in object properties"
' Call DumpBuiltinProperties(obj_Excel)
WScript.Echo "Dump obj_Workbook built-in object properties"
Call DumpBuiltinProperties(obj_Workbook)

' Built-in property 'Last author' == 'Paul Thompson - US'   {String}
' Built-in property 'Revision number' == '1'   {String}
' Built-in property 'Last save time' == '12/14/2014 10:23:59 PM'   {Date}
' Built-in property 'Document version' == '1'   {String}


   vnt_LastAuthor = obj_Workbook.BuiltInDocumentProperties("Last Author").Value
   vnt_DocVersion = obj_Workbook.BuiltInDocumentProperties("Document version").Value
   vnt_DocRev = obj_Workbook.BuiltInDocumentProperties("Revision number").Value
   vnt_LastSaveTime = obj_Workbook.BuiltInDocumentProperties("Last save time").Value

   ' Cleanup, close everything and quit.
   obj_Workbook.Close
   obj_Excel.Quit
   Set obj_Workbook = Nothing
   Set obj_Excel = Nothing
End Sub

' *****************************************************************************

Sub GetWordProps(x)

'  Excel.Application
'  Word.Application
'  PowerPoint.Application
'  Publisher.Application
'  Project.Application
'  Access.Application
'  OneNote.Application
'  InfoPath.Application
'  Outlook.Application
'  SharePoint.Application
'  Visio.Application




'  Set objExcel = CreateObject("Excel.Application")
'  objExcel.Visible = True
'  Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls")

'  For Each strProperty in objWorkbook.BuiltInDocumentProperties
'      Wscript.Echo strProperty.Name
'  Next

' ReadOnly Property CustomDocumentProperties As Object

'  Member name                   Description
'  wdPropertyTitle               Title.
'  wdPropertySubject             Subject.
'  wdPropertyAuthor              Author.
'  wdPropertyKeywords            Keywords.
'  wdPropertyComments            Comments.
'  wdPropertyTemplate            Template name.
'  wdPropertyLastAuthor          Last author.
'  wdPropertyRevision            Revision number.
'  wdPropertyAppName             Name of application.
'  wdPropertyTimeLastPrinted     Time last printed.
'  wdPropertyTimeCreated         Time created.
'  wdPropertyTimeLastSaved       Time last saved.
'  wdPropertyVBATotalEdit        Number of edits to VBA project.
'  wdPropertyPages               Page count.
'  wdPropertyWords               Word count.
'  wdPropertyCharacters          Character count.
'  wdPropertySecurity            Security setting.
'  wdPropertyCategory            Category.
'  wdPropertyFormat              Not supported.
'  wdPropertyManager             Manager.
'  wdPropertyCompany             Company.
'  wdPropertyBytes               Byte count.
'  wdPropertyLines               Line count.
'  wdPropertyParas               Paragraph count.
'  wdPropertySlides              Not supported.
'  wdPropertyNotes               Notes.
'  wdPropertyHiddenSlides        Not supported.
'  wdPropertyMMClips             Not supported.
'  wdPropertyHyperlinkBase       Not supported.
'  wdPropertyCharsWSpaces        Character count with spaces.

End Sub



WScript.Quit


' Word:
' Last saved by
'Revision number
'Version number
'Date last saved

' *****************************************************************************

Function IsoTime(dt)
   If IsDate(dt) Then
      IsoTime = CStr(Year(dt)) & ZeroPad(Month(dt),2) & ZeroPad(Day(dt),2) & ZeroPad(Hour(dt),2) & ZeroPad(Minute(dt),2)
   Else
      IsoTime = "000000000000"
   End If
End Function

Function ZeroPad(vnt,n_Len)
   ZeroPad = Trim(CStr(vnt))
   While Len(ZeroPad) < n_Len
      ZeroPad = "0" & ZeroPad
   Wend
End Function




Function UserInitials(str)

End Function
